ftp.mactech.com 2010/ftp.mactech.com.tar/ftp.mactech.com/thinkref/archive/THINKPascal4.0.2Update.sea.hqx/THINK Pascal 4.0.2 Update/Misc Updates.sea/THINK Pascal 4.0 Folder/UMemory.p

Text File | 1992-06-16 | 62KB | 2,207 lines

{    This file has been processed by The THINK Pascal Source Converter, v1.1.2.    }

{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n+]}
{ UMemory.p }
{ Copyright © 1984-1990  Apple Computer, Inc.  All rights reserved. }

{$IFC UNDEFINED UsingIncludes}
{$SETC UsingIncludes := FALSE}
{$ENDC}

unit UMemory;

interface

    uses
        SysEqu, Traps, ULoMem,
{$SETC __UMemory__ := TRUE}
{ • MacApp }
        UMacAppUtilities, UFailure,
{ • Required for this unit's interface }

{ • Implementation use }
        UPatch,

        UDebug;


            { • Include the public interface }



{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UMemory.p }
{ Copyright © 1985-1990 by Apple Computer, Inc.  All rights reserved. }

{[f-]}
{}
{    This unit implements MacApp's memory management and segment management}
{    schemes.}
{}
{    The memory management scheme works by distinguishing between "permanent"}
{    and "temporary" heap allocation requests.    Permanent requests are}
{    typically used for data your application allocates:  objects and}
{    handles.  Temporary requests are used for code segments and Toolbox}
{    resources and data, such as WDEF's and CDEF's.}
{}
{    Permanent memory objects are considered permanent because they}
{    are not purged from memory until you explicitly dispose of or free them.}
{    (Of course, the Macintosh Memory Manager will purge them if they're}
{    marked purgeable.)    Permanent objects are allocated with NewPermHandle.}
{    This prevents the MacApp GrowZone from purging temporary objects to}
{    accommodate a permanent one.  In MacApp, all TObjects and its descendants}
{    are considered permanent, and are allocated with NewPermHandle.}
{}
{    Temporary memory objects are considered temporary because MacApp's}
{    GrowZone procedure may purge them from memory to satisfy a memory}
{    allocation request.  This is true regardless of whether the object is}
{    marked non-purgeable, although the GrowZone procedure will not purge}
{    locked objects (such as code segments in use).    Typically, temporary}
{    objects are marked non-purgeable so that MacApp's GrowZone can control}
{    when they are purged.}
{}
{    MacApp reserves a specific amount of heap space for temporary objects,}
{    the idea being that the space reserved is large enough to handle the}
{    largest number of temporary objects (e.g. code and system resources)}
{    needed at any given time.    If this amount is sufficiently large, your}
{    program will never fail loading a segment or system resource.    This}
{    amount is defined by the internal variable pSzCodeReserve.    You can}
{    retrieve its value by calling GetReserveSize.    It is initially set by}
{    the 'seg!' and 'mem!' resources, and can be changed at run-time by}
{    calling SetReserveSize.  The procedure BuildCodeReserve reserves the}
{    space by allocating the handle pCodeReserve and setting its size to}
{    pSzCodeReserve - (the total size of all temporary objects in memory}
{    [at that time]).}
{}
{    When a temporary object is loaded into memory, the size of pCodeReserve}
{    is adjusted accordingly. Permanent objects can be loaded into memory}
{    only so long as there will still be at least pSzCodeReserve bytes}
{    available for temporary objects.}
{}
{    To identify which objects in the heap are temporary, MacApp maintains}
{    four lists of handles.    The objects identified by these handles are}
{    considered temporary and fall under the control of MacApp's GrowZone}
{    procedure.    The lists are:}
{}
{    gCodeSegs - A list of handles to all CODE resources in the application}
{    and system resource forks.}
{}
{    gSysMemList - A list handles to RAM-based system resources.}
{    By default this list includes all PACK, LDEF, MDEF, CDEF and WDEF}
{    resources in the system and application resource forks. You can add}
{    other resources, such as fonts, by calling AddHandle.}
{}
{    gApp1MemList, gApp2MemList - Lists of handles to application data or}
{    resources.    MacApp initializes both lists to NIL.  The difference}
{    between the two lists is that handles in gApp1MemList are purged}
{    before those in gApp2MemList.  You may add your own handles to these}
{    lists by allocating them with NewHandle and calling AddHandle for each}
{    handle to be added to the list.}
{}
{    The Macintosh Memory Manager calls MacApp's GrowZone procedure only when}
{    all purgeable objects have been purged from the heap and there is still}
{    insufficient space to satisfy a memory request.  The GrowZone will}
{    look through the lists of temporary objects in memory, making one}
{    purgeable so long as there is still at least pSzCodeReserve bytes}
{    allocated to temporary memory (the total size of the temporary objects}
{    in memory and the pCodeReserve handle).  The GrowZone procedure attempts}
{    to never allow the size of the temporary objects and reserve to fall}
{    below pSzCodeReserve, thereby guaranteeing that space is always avail-}
{    able for code segments and system resources (provided pSzCodeReserve is}
{    large enough to handle your application at its most memory intensive}
{    state).}
{}
{    The value of pSzCodeReserve is determined at startup-time by adding up}
{    the size of all the segments named in the 'seg!' resources, and adding}
{    the first value of each of the 'mem!' resources.  You can derive these}
{    resources by observing your program and using the MacApp debugger to}
{    help you determine when your application uses the largest amount of}
{    code and system resources.    Typically, we've found that this happens}
{    while printing on the LaserWriter, or during initialization or term-}
{    ination.}
{}
{    MacApp maintains another reserve, known as the low memory reserve.}
{    This is a kind of emergency reserve--when all else fails we release}
{    the pMemReserve handle.  Its size is initially determined by the second}
{    number of each 'mem!' resource, and can be changed by calling}
{    SetReserveSize.  You can retrieve its size by calling GetReserveSize.}
{    Internally, the low-memory reserve is allocated with the pMemReserve}
{    handle, and its size is stored in pSzMemReserve.}
{}
{    The procedure InitUMemory is responsible for initially setting up the}
{    temporary and low-memory reserves, setting up the GrowZone procedure,}
{    initializing handle lists, and patching LoadSeg.  It signals failure}
{    if the temporary reserve could not be allocated.}
{}
{[f+]}

{$IFC UNDEFINED UsingIncludes}
{$SETC UsingIncludes := FALSE}
{$ENDC}








        { • Auto-Include the requirements for this unit's interface. }








    const
        kGZMaxAlloc = $7FFFFFFF;
        kCode = 'CODE';                { Resource type for code }

    type

        AHandleList = array[1..5000] of Handle; { A list of handles }
        HandleListPtr = ^AHandleList;         { Preferred }
        HandleListHandle = ^HandleListPtr;        { Preferred }
        PHandleList = HandleListPtr;        { Left in for compatibility (2.0) }
        HHandleList = HandleListHandle;     { Left in for compatibility (2.0) }

        ABoolList = array[1..5000] of BOOLEAN; { A list of BOOLEAN }
        BoolListPtr = ^ABoolList;
        BoolListHandle = ^BoolListPtr;

        ALongList = array[1..5000] of LONGINT; { A list of LONGINT }
        LongListPtr = ^ALongList;
        LongListHandle = ^LongListPtr;

    var
        gMaxLockedRsrc: Size;                    { The maximum memory consumed by locked}
{                                                         resources. See CheckRsrcUsage procedure.}
            {$IFC qDebug}
        gMemMgtBreak: BOOLEAN;                { if TRUE, break into debugger rather than}
{                                                         just report memory mgt. information}
        gRsrcReport: BOOLEAN;                { Report resource maximums to the debugger}
{                                                         window.}
        gSegReport: BOOLEAN;                { Report segment loadings to the debugger}
{                                                         window.}
            {$ENDC}
        gSysMemList: HandleListHandle;        { List of system handles used to compute}
{                                                         current allocated temporary memory (all}
{                                                         PACK, LDEF, MDEF, CDEF, WDEF resources).}
{                                                         See ScanHandles procedure.}
        gApp1MemList,                                { an application defined memlist }
        gApp2MemList: HandleListHandle;        { These start out NIL. You can create lists}
{                                                         of handles and place then in either of}
{                                                         these variables. (One list might be}
{                                                         permanent handles in your application, and}
{                                                         the other based on the current situation.)}
{                                                         The values stored here should be a handle}
{                                                         to a list of other handles. If you modify}
{                                                         either of these lists, call CheckReserve.}
{                                                         It calls BuildAllReserves to recompute the}
{                                                         code and low space reserve. CheckReserve's}
{                                                         result indicates whether the full code}
{                                                         reserve is present. If not, then your}
{                                                         program may crash because a segment (or}
{                                                         defproc) can't be loaded. The handles in}
{                                                         the lists should normally be resources}
{                                                         that your application might require at any}
{                                                         given time. All these handles will}
{                                                         normally be marked non-purgeable. The}
{                                                         GrowZone proc, however, can purge any of}
{                                                         these handles that are not locked.}

        gCodeRefNum: INTEGER;                { Reference to where to find code segements}
{}

        gCodeSegs: HandleListHandle;        { List of all code segments }
        gIsLoadedSeg: BoolListHandle;            { Maintains a flag for each segment,}
{                                                         indicating whether the segment is loaded (in the}
{                                                         segment loader sense).  Thereby optimizing}
{                                                         UnloadAllSegments.}
        gIsResidentSeg: BoolListHandle;            { Maintains a flag for each segment,}
{                                                         indicating whether the segment is resident}
{                                                         and hence should not be unloaded (in the}
{                                                         segment loader sense).}

        gUnloadAllSegs: BOOLEAN;                { UnloadAllSegments doesn't unload segments}
{                                                        if this flag is false.}

        gGZPurgeNotify: ProcPtr;                { If non-NIL, then this will be called}
{                                                         before the Grow Zone proc purges a handle.}
{                                                         The proc will be passed the actual handle.}
{}
            { These are meant to be private but are in the interface just in case. }
        pSegSize: LongListHandle;            { Maintains size of each code resource. }

        pCodeReserve: Handle;                 { Allocates temporary (code) reserve. }
        pMemReserve: Handle;                 { Allocates low memory reserve. }
        pOKCodeReserve: BOOLEAN;                { if TRUE then we have an adequate code}
{                                                         reserve; if FALSE then the application}
{                                                         could crash if memory is tight}
        pPermAllocation: BOOLEAN;
        pReserveExists: BOOLEAN;                { TRUE if the code reserve is known to be}
{                                                         fully allocated}
            {$IFC qDebug}
        pReserveShortfall: LONGINT;                { amt. that we are lacking in the code}
{                                                         reserve}
            {$ENDC}
        pSzCodeReserve: Size;                    { Attempt to reserve this much memory for}
{                                                         the temporary (code) reserve.}
        pSzMemReserve: Size;                    { Attempt to reserve this much memory for}
{                                                         the low-memory reserve.}

        pSegLoadPatch: TrapPatch;                { patch for LoadSeg }

        pOldResFile: INTEGER;                { The res file reference saved across}
{                                                         segloads}
        pLoadSegCalledFromOwnApp: BOOLEAN;            { TRUE if calling LoadMacAppSeg from the app}
{                                                         and not from a _DA_ in our own heap.}
{                                                         (wheels within wheels for Pete's sake!)}

        pMaxSegNum: INTEGER;                { The maximum segment number }

            { I N I T I A L I Z A T I O N }

    procedure InitUMemory;
        { Initializes this unit. Must be called before using this unit. The caller must be in the}
{        program's main segment. Sets up the gCodeSegs and gSysMemList handle lists, sets the grow}
{        zone, calls MaxApplZone, sets gApp1MemList and gApp2MemList to NIL, patches LoadSeg and}
{        allocates the temporary and low-memory reserves. Fails if unable to allocate the temporary}
{        reserve.}

        { S E G M E N T   L O A D I N G }

        { DEBUGGING NOTE: You cannot set a MacApp breakpoint at any of these}
{        routines, because they must not call anything (eg. %_BP) that may}
{        require a segment load.}

    function GetSegNumber (aProc: ProcPtr): INTEGER;
        { GetSegNumber returns the number of the segment in which aProc resides. }

    function GetSegFromPC (ppc: LONGINT): INTEGER;
        { Given a pc pointer, return the segment number or 0 if not found.}
{        Must be a loaded code segment.}

    function GetSegSize (segnum: INTEGER): Size;
        { GetSegSize returns the size, in bytes, of the segment whose number is segnum. }

    function LoadMacAppSegment (segnum: INTEGER): LONGINT;
        { This function patches LoadSeg. It is called from the assembly-language routine}
{        AMacAppLoadSeg, which is the actual patch setup by PatchTrap. AMacAppLoadSeg saves}
{        registers and sets up the stack by 1) allocating space for LoadMacAppSegment's result,}
{        and 2) pushing a copy of LoadSeg's parameter onto the stack for use by LoadMacAppSegment.}
{        Signals failure if the segment could not be loaded.}

    procedure LoadResidentSegments;
        { Makes resident the segments whose names are included in any 'res!' resources. }

    function PreloadSegment (segnum: INTEGER): BOOLEAN;
        { PreloadSegment calls PreloadSegmentResource to load a segment in the resource manager}
{        sense and then calls the segment loader to load it in the segment loader sense.}

    function PreloadSegmentResource (segnum: INTEGER): BOOLEAN;
        { PreloadSegment is available to programmers who want to lock a segment at the top of the}
{        heap without having to call a dummy procedure in that segment. It is also useful for}
{        determining whether a segment can in fact be loaded before you try to execute code in it.}
{        PreloadSegment returns TRUE if the segment could be loaded, false otherwise.}

    procedure SetResidentSegment (segnum: INTEGER; makeResident: BOOLEAN);
        { SetResidentSegment can be used to make a segment resident (or no longer resident); resident}
{        segments will not be unloaded by UnloadAllSegments; if a segment is made resident, it is}
{        also preloaded.MacApp® automatically marks its resident segment as resident (the one}
{        containing the procedure CmdFromMenuItem); you probably should do UnloadAllSegments before}
{        making a segment resident, to ensure that it is locked at the top of the heap.}

    procedure UnloadAllSegments;
        { UnloadAllSegments unloads all segments except the blank segment or the ones marked}
{        resident. It is called at each iteration of the main event loop to compact memory, as well}
{        as other places where compacting memory is needed or desirable.}

        { H A N D L E L I S T    M A N A G E M E N T }

    procedure AddHandle (h: Handle; toList: HandleListHandle);
        { Adds a handle to the list of handles; does not check if the handle already exists in the}
{        list. Simply calls Munger to add to the front of the list.}

    procedure AddAllRsrc (rType: ResType; toList: HandleListHandle);
        { Adds all the resources of type rType to the list. Filters out all ROM resources.Calls}
{        AddHandle.}

    procedure RemHandle (h: Handle; toList: HandleListHandle);
        { Removes the handle from list. }

    procedure ScanHandles (procedure DoToHandle (h: Handle));
        { Calls DoToHandle for each handle in the lists gCodeSegs, gSysMemList, gApp1MemList and}
{        gApp2MemList. This procedure assumes that DoToHandle does not compact memory.}

        { M E M O R Y M A N A G E M E N T }

    procedure BuildAllReserves;
        { BuildAllReserves creates the code (temporary memory) and low space reserves. These are kept}
{        for use at a time when an out-of-memory condition has occurred to allow most such}
{        occurrances to recover smoothly by deallocating the space.}

    function CheckReserve: BOOLEAN;
        { Checks to see if the code reserve is OK. Calls BuildAllReserves and returns true if the}
{        full code reserve is present. If this returns false your application may bomb because a}
{        segment or system resource can't be loaded.}

        {$IFC qDebug}

    procedure CheckRsrcUsage;
        { Checks to see if the total size of the currently loaded resources exceeds the maximum}
{        (gMaxLockedRsrc).If so, the new maximum is set.If gRsrcReport is true, then the new maximum}
{        is reported in the debugger window.If gMemMgtBreak then program execution is stopped.}
        {$ENDC qDebug}

        {$IFC qDebug}

    procedure DoChangeReserve (alter: BOOLEAN; var codeReserve, codeShort, lowSpaceReserve: Size; var gotCode, gotLowSpace: BOOLEAN);
        { Called by the MacApp® debugger to change the reserve allocation. Not normally called by an}
{        application.}
        {$ENDC qDebug}

    procedure FailNoReserve;
        { IF NOT CheckReserve THEN Failure(memFullErr, 0). }

    procedure FailSpaceIsLow;
        { IF MemSpaceIsLow THEN Failure(memFullErr, 0). }

    procedure GetReserveSize (var szCodeReserve, szMemReserve: Size);
        { Returns the amount of memory that is to be reserved for the code and memory reserve. This}
{        is not a true indication of whether this amount of memory has in fact been reserved. Call}
{        CheckReserve to find out if the code reserve could be allocated, and call MemSpaceIsLow to}
{        find out if the low-memory reserve could be allocated.}

    function MemSpaceIsLow: BOOLEAN;
        { Returns TRUE if the low space reserve is missing. }

    function NewPermPtr (logicalSize: Size): Ptr;
        { Allocates a permanent Pointer; you should call this instead of NewPointer if allocating}
{        some permanent memory.}

    function NewPermHandle (logicalSize: Size): Handle;
        { Allocates a permanent handle; you should call this instead of NewHandle if allocating some}
{        permanent memory.}

    function PermAllocation (permanent: BOOLEAN): BOOLEAN;
        { PermAllocation controls whether subsequent memory allocations are considered permanent or}
{        temporary.Pass TRUE to setup things for a permanent allocation.Returns the previous state}
{        of the permanent flag.}

    procedure SetPermHandleSize (h: Handle; newSize: Size);
        { Use this call to size permanent handles. It sets/resets the permanent flag correctly and}
{        does a FailMemError.}

    procedure SetPermPtrSize (p: Ptr; newSize: Size);
        { Use this call to size permanent pointers. It sets/resets the permanent flag correctly and}
{        does a FailMemError.}

    procedure SetReserveSize (forCode, forOther: Size);
        { Call this to set the size of the memory reserved for code (temporary) and permanent (low}
{        memory) requests.}

    function TotalTempSize (justLocked: BOOLEAN; var canPurge: Handle): Size;
        { TotalTempSize returns the total number of bytes of the temporary handles currently in RAM}
{        (or only locked/in use handles if justLocked is TRUE).  CanPurge is set to an unlocked}
{        handle that can be purged if desired.  Uses ScanHandles.}

        {$IFC qDebug}

    procedure WriteReserves;
        { WRITELN's the temporary reserve and low-memory reserves in the debug window. }
        {$ENDC}

        { U T I L I T I E S }

    function AddSegSizes (segRsrc: Handle): Size;
        { Returns the total size of the code segments whose names are in the string list segRrsc. }

    procedure SetStackSpace (numBytes: Size);
        { Set the stack space to at least numBytes. }


    procedure WithCodeResFileDo (procedure DoWithResFile);
        { Ensure that the resource call is done against gCodeRefNum }




implementation


{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UMemory.inc1.p }
{ Copyright © 1985-1990 by Apple Computer, Inc.  All rights reserved. }



{$R-}

{$V-}


    var
        pDuringGrowZone: BOOLEAN;

    function GrowZoneProc (needed: Size): LONGINT;
    FORWARD;

    procedure BuildCodeReserve (allocLim: Size; fromGZ: BOOLEAN);
    FORWARD;

    function HandleIsEligible (h: Handle): BOOLEAN;
    FORWARD;

{--------------------------------------------------------------------------------------------------}

    procedure ALoadMacAppSeg;
    EXTERNAL;

    procedure APostLoadMacAppSeg;
    EXTERNAL;
 { LoadSeg is Patched to call ALoadMacAppSeg, which in turn calls}
{  LoadMacAppSegment. ALoadMacAppSeg can only be referenced as a}
{  procedure pointer, because no args are declared}

    procedure EachFrameDo (calleeFrame, ppc: LONGINT; procedure DoToFrame (calleeFrame: LONGINT; ppc: LONGINT; callerFrame: LONGINT; itsFrame: LONGINT));
    EXTERNAL;

    function PreloadSegment (segNum: INTEGER): BOOLEAN;
    EXTERNAL;

    procedure CallNotify (h: Handle; routine: ProcPtr);
    inline
        $205F, $4E90;                                { MOVE.L (A7)+,A0; JSR (A0) }

{--------------------------------------------------------------------------------------------------}

    {}
{    These "MAFoo" functions are primarily for THINK™ Pascal compatibility (but useful in the larger}
{    problem of multiple open resource maps in general); when running under the THINK™ environment,}
{    CODE resources are not found in the same resource file as other application resources, so a}
{    UseResFile call needs to be made to bring the project resource file into the search path.}
{    "gCodeRefNum" is set up at initialization time.}
{    !!! A much more general solution to "the resource problem" appears to be warranted.}
{}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MAGet1Resource (rType: ResType; rID: INTEGER): Handle;

        var
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        MAGet1Resource := Get1Resource(rType, rID);
        if MAUseResFile(oldResFile) <> 0 then
            ;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MAGet1NamedResource (rType: ResType; name: Str255): Handle;

        var
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        MAGet1NamedResource := Get1NamedResource(rType, name);
        if MAUseResFile(oldResFile) <> 0 then
            ;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MAGet1IndResource (rType: ResType; index: INTEGER): Handle;

        var
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        MAGet1IndResource := Get1IndResource(rType, index);
        if MAUseResFile(oldResFile) <> 0 then
            ;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MACount1Resources (rType: ResType): INTEGER;

        var
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        MACount1Resources := Count1Resources(rType);
        if MAUseResFile(oldResFile) <> 0 then
            ;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MAGetResource (rType: ResType; rID: INTEGER): Handle;

        var
            h: Handle;
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        h := GetResource(rType, rID);
        if MAUseResFile(oldResFile) <> 0 then
            ;

        if HomeResFile(h) <> gCodeRefNum then
            h := nil;

        MAGetResource := h;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MAGetNamedResource (rType: ResType; name: Str255): Handle;

        var
            h: Handle;
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        h := GetNamedResource(rType, name);
        if MAUseResFile(oldResFile) <> 0 then
            ;

        if HomeResFile(h) <> gCodeRefNum then
            h := nil;

        MAGetNamedResource := h;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MAGetIndResource (rType: ResType; index: INTEGER): Handle;

        var
            h: Handle;
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        h := GetIndResource(rType, index);
        if MAUseResFile(oldResFile) <> 0 then
            ;

        if HomeResFile(h) <> gCodeRefNum then
            h := nil;

        MAGetIndResource := h;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MACountResources (rType: ResType): INTEGER;

        var
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        MACountResources := CountResources(rType);
        if MAUseResFile(oldResFile) <> 0 then
            ;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function GetSegResource (segNum: INTEGER): Handle;

    begin
        if qNeedsROM128k | gConfiguration.hasROM128k then
            GetSegResource := MAGet1Resource(kCode, segNum)
        else
            GetSegResource := MAGetResource(kCode, segNum);
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

    procedure AddAllRsrc (rType: ResType; toList: HandleListHandle);

        var
            oldResLoad: BOOLEAN;
            i: INTEGER;
            h: Handle;
            theID: INTEGER;
            theType: ResType;
            theName: Str255;

    begin
        oldResLoad := GetResLoad;
        SetResLoad(FALSE);

        for i := 1 to CountResources(rType) do
            begin
                h := GetIndResource(rType, i);
                GetResInfo(h, theID, theType, theName);

  { If there is a ROM resource for this type and ID, don't put it}
{   on the list.}
                UseROMMap(FALSE);
                h := GetResource(rType, theID);
                UseROMMap(FALSE);
                if HomeResFile(h) <> 1 then
                    AddHandle(h, toList);

            end;

        SetResLoad(oldResLoad);
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

    procedure AddHandle (h: Handle; toList: HandleListHandle);

        var
            offset: LONGINT;

    begin
        offset := Munger(Handle(toList), 0, nil, 0, @h, 4);
        FailMemError;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

    function AddSegSizes (segRsrc: Handle): LONGINT;

        var
            p: SignedBytePtr;
            oldResLoad: BOOLEAN;
            total: LONGINT;
            seg: Handle;
            i: INTEGER;
            s: Str255;

    begin
        LockHandleHigh(segRsrc);

        oldResLoad := GetResLoad;
        SetResLoad(FALSE);

        p := SignedBytePtr(segRsrc^);
        i := IntegerPtr(p)^;
        p := SignedBytePtr(Ord(p) + 2);

        total := 0;

        while i > 0 do
            begin
                BlockMove(Ptr(p), @s, p^ + 1);

                p := SignedBytePtr(Ord(p) + p^ + 1);
                i := i - 1;

                if qNeedsROM128k | gConfiguration.hasROM128k then
                    seg := MAGet1NamedResource(kCode, s)
                else
                    seg := MAGetNamedResource(kCode, s);

                if seg <> nil then
                    total := total + SizeResource(seg) + 8;
            end;

        AddSegSizes := total;

        SetResLoad(oldResLoad);

        HUnlock(segRsrc);
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    procedure BuildAllReserves;

        const
            initVal = $F7;

        var
            oldPerm: BOOLEAN;
        {$IFC qDebug}
            theSize: Size;
        {$EndC}

    begin
  { set the permanent flag to ensure that the code reserve is}
{   actually allocated and not given up to the low space reserve}
        oldPerm := pPermAllocation;
        pPermAllocation := TRUE;

    { make sure code reserve is OK }
        BuildCodeReserve(kGZMaxAlloc, FALSE);

    { reallocate the low space handle, if necessary }
        if IsHandlePurged(pMemReserve) then
            begin

                ReallocHandle(pMemReserve, pSzMemReserve);
        {$IFC qDebug}
                theSize := GetHandleSize(pMemReserve);
        {$Push}
 {$R-}
                if theSize <> 0 then
                    BlockSet(pMemReserve^, theSize, initVal);
        {$Pop}
        {$EndC}
            end;

    { reset the permanent flag }
        pPermAllocation := oldPerm;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    procedure BuildCodeReserve (allocLim: Size; fromGZ: BOOLEAN);

        const
            initVal = $F7;

        var
            needed: Size;
            avail: Size;
            canPurge: Handle;
        {$IFC qDebug}
            theSize: Size;
        {$EndC}

    begin
        pOKCodeReserve := TRUE;                             { default value }

    {$IFC qDebug}
        pReserveShortfall := 0;

        if not pPermAllocation then
            ProgramBreak('BuildCodeReserve called with pPermAllocation = FALSE');
    {$ENDC qDebug}

        if not pReserveExists then
            begin
                pReserveExists := TRUE;                         { default value }

        { free the current code reserve }
                if HandleIsEligible(pCodeReserve) then
                    EmptyHandle(pCodeReserve);

        { compute amt actually needed }
                needed := Min(pSzCodeReserve - TotalTempSize(FALSE, canPurge) - 8, allocLim);

                if needed > 0 then
                    begin
            { make as much memory available as possible }
                        if HandleIsEligible(pMemReserve) then
                            EmptyHandle(pMemReserve);

                        if fromGZ then                                { Never purge or compact from GrowZone }
                            avail := allocLim
                        else
                            begin
                                PurgeMem(needed);
                                avail := CompactMem(needed);
                            end;

                        if avail < needed then                        { could not get the whole reserve }
                            begin
                {$IFC qDebug}
                                pReserveShortfall := needed - avail;
                {$ENDC}

                                pOKCodeReserve := FALSE;
                                pReserveExists := FALSE;

                                needed := avail;                        { get the most we can }
                            end;

                        if (not fromGZ) & (IsHandlePurged(pCodeReserve) | HandleIsEligible(pCodeReserve)) then
                            ReallocHandle(pCodeReserve, needed);
            {$IFC qDebug}
                        theSize := GetHandleSize(pCodeReserve);
            {$Push}
 {$R-}
                        if theSize <> 0 then
                            BlockSet(pCodeReserve^, theSize, initVal);
            {$Pop}
            {$EndC}
                        if not IsHandlePurged(pCodeReserve) then
                            begin
                { Large handles are almost as bad as nonrelocatable blocks.}
{                    Try to get this guy out of the way, just in case.}
                                if not fromGZ then
                                    MoveHHi(pCodeReserve);
                            end;
                    end;
            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function CheckReserve: BOOLEAN;

    begin
        BuildAllReserves;
        CheckReserve := pOKCodeReserve;
    end;

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S MAMemoryRes}

    procedure CheckRsrcUsage;

        var
            sz: LONGINT;
            h: Handle;
            s: Str255;

    begin
        sz := TotalTempSize(TRUE, h);
        if sz > gMaxLockedRsrc then
            begin
                gMaxLockedRsrc := sz;
                if gRsrcReport then
                    begin
                        NumToString(gMaxLockedRsrc, s);
                        s := Concat('  == New maximum resources usage: ', s, ' ==');
                        ProgramReport(s, gMemMgtBreak);
                    end;
            end;
    end;
{$ENDC qDebug}

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S MADebug}

    procedure DoChangeReserve (alter: BOOLEAN; var codeReserve, codeShort, lowSpaceReserve: LONGINT; var gotCode, gotLowSpace: BOOLEAN);

        var
            x: LONGINT;
            s: Str255;

    begin
        if alter then
            begin
                Write('code reserve size = ', pSzCodeReserve : 1, '  ');
                if pOKCodeReserve then
                    Writeln(' (OK)')
                else
                    Writeln(' (gone)');

                Write('low space reserve size = ', pSzMemReserve : 1, '  ');
                if not IsHandlePurged(pMemReserve) then
                    Writeln(' (OK)')
                else
                    Writeln(' (gone)');

                Writeln;

                Write('New code reserve (-1 = no change): ');
                Readln(x);
                if x >= 0 then
                    codeReserve := x
                else
                    codeReserve := pSzCodeReserve;

                Write('New low space reserve (-1 = no change): ');
                Readln(x);
                if x >= 0 then
                    lowSpaceReserve := x
                else
                    lowSpaceReserve := pSzMemReserve;

                Write('Reset max resource usage (Y or N) [N]? ');
                Readln(s);
                if s <> '' then
                    if (s[1] = 'y') | (s[1] = 'Y') then
                        begin
                            gMaxLockedRsrc := 0;
                        end;

                Writeln;

                SetReserveSize(codeReserve, lowSpaceReserve);
            end
        else
            BuildAllReserves;

        codeReserve := pSzCodeReserve;
        codeShort := pReserveShortfall;
        lowSpaceReserve := pSzMemReserve;
        gotCode := pOKCodeReserve;
        gotLowSpace := not IsHandlePurged(pMemReserve);
    end;
{$ENDC qDebug}

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

    procedure DoInitUMemory (var sizeTempReserve, sizeLowSpaceReserve: Size);

 { Called from InitUMemory so that InitUMemory can be in the main segment}
{  and this code can be in another (unloadable) segment.}

        type
            Mem = record                    { format of the mem! resource }
                    codeVal, lowSpaceVal, stackVal: LONGINT;
                end;
            MemPtr = ^Mem;
            MemHandle = ^MemPtr;

        var
            i: INTEGER;
            oldResLoad: BOOLEAN;
            seg: Handle;
            StackTot: LONGINT;
            h: Handle;
            rsrcID: INTEGER;
            rsrcType: ResType;
            rsrcName: Str255;
            lastRsrc: INTEGER;
            mainSegment, utilitySegment: INTEGER;

    begin
    { Initialize memory management globals }
        pPermAllocation := FALSE;
        pMemReserve := NewHandle(0);
        FailNil(pMemReserve);

        pSzMemReserve := 0;
        pCodeReserve := NewHandle(0);
        FailNil(pCodeReserve);

        pSzCodeReserve := 0;
        gGZPurgeNotify := nil;
        pOKCodeReserve := TRUE;
        pReserveExists := FALSE;
    {$IFC qDebug}
        gSegReport := FALSE;
    {$EndC}

        gUnloadAllSegs := TRUE;

        gCodeRefNum := HomeResFile(GetResource(kCode, 1));    { Get homeresfile of "Main".}
{                                                        It better be there!!}
        pMaxSegNum := 0;

    {###########################################}
    { No resource loading }

        oldResLoad := GetResLoad;
        SetResLoad(FALSE);

    { Figure the highest segment number }
        if qNeedsROM128k | gConfiguration.hasROM128k then
            lastRsrc := MACount1Resources(kCode)
        else
            lastRsrc := MACountResources(kCode);

    { some development systems may not have contiguous numbering of CODE segments.}
{    try to be polite about handling it}
        for i := 1 to lastRsrc do
            begin
                if qNeedsROM128k | gConfiguration.hasROM128k then
                    seg := MAGet1IndResource(kCode, i)
                else
                    seg := MAGetIndResource(kCode, i);
        { we only have an index… find the real resource ID and keep track}
{        of the highest one}
                if (seg <> nil) then
                    begin
                        GetResInfo(seg, rsrcID, rsrcType, rsrcName);
                        pMaxSegNum := Max(rsrcID, pMaxSegNum);
                    end;
            end;


        SetResLoad(oldResLoad); { in case of failure }

    { Allocate the master segment lists.}
        gCodeSegs := HandleListHandle(NewHandle(pMaxSegNum * SizeOf(Handle)));
        FailNil(gCodeSegs);

        gIsResidentSeg := BoolListHandle(NewHandle(SizeOf(BOOLEAN) * pMaxSegNum));
        FailNil(gIsResidentSeg);

        gIsLoadedSeg := BoolListHandle(NewHandle(SizeOf(BOOLEAN) * pMaxSegNum));
        FailNil(gIsLoadedSeg);

    { (NOTE: assumes application doesn't change the CODE segment size at runtime}
{    (a very safe assumption)). Used in GetSegFromPC.}
        pSegSize := LongListHandle(NewHandle(SizeOf(LONGINT) * pMaxSegNum));
        FailNil(pSegSize);

        oldResLoad := GetResLoad; { OK, suppress segment loading again }
        SetResLoad(FALSE);    { !!! Need an MAResLoad that returns old state }

    { Initialize segment lists.}
        for i := 1 to pMaxSegNum do
            gIsResidentSeg^^[i] := FALSE;

    { Segments and their sizes and actual loaded state (helps catch preloads) }
        for i := 1 to pMaxSegNum do
            begin
                seg := GetSegResource(i);
                gCodeSegs^^[i] := seg;
                if seg <> nil then { seg is non-nil if the segment number exists }
                    begin
                        pSegSize^^[i] := SizeResource(seg);
                        gIsLoadedSeg^^[i] := IsHandleLocked(seg);
                    end
                else
                    begin
                        pSegSize^^[i] := 0;
                        gIsLoadedSeg^^[i] := FALSE;
                    end;
            end;

        SetResLoad(oldResLoad);
    {###########################################}

        mainSegment := GetSegNumber(@InitUMemory);            { Main is always resident }
        gIsResidentSeg^^[mainSegment] := TRUE;
        gIsLoadedSeg^^[mainSegment] := TRUE;

        utilitySegment := GetSegNumber(@UnloadAllSegments); { Utilities are always resident }
        gIsResidentSeg^^[utilitySegment] := TRUE;
        gIsLoadedSeg^^[utilitySegment] := TRUE;

    { init the gSysMemList }
        gSysMemList := HandleListHandle(NewHandle(0));
        FailNil(gSysMemList);

        AddAllRsrc('LDEF', gSysMemList);
        AddAllRsrc('CDEF', gSysMemList);
        AddAllRsrc('MDEF', gSysMemList);
        AddAllRsrc('WDEF', gSysMemList);
        AddAllRsrc('PACK', gSysMemList);

    { Compute memory slop needed }
        sizeTempReserve := 0;
        sizeLowSpaceReserve := 0;
        StackTot := 0;

        for i := 1 to CountResources('seg!') do
            begin
                h := GetIndResource('seg!', i);
                sizeTempReserve := sizeTempReserve + AddSegSizes(h);
                ReleaseResource(h);
            end;

        for i := 1 to CountResources('mem!') do
            begin
                h := GetIndResource('mem!', i);
                with MemHandle(h)^^ do
                    begin
                        sizeTempReserve := sizeTempReserve + codeVal;
                        sizeLowSpaceReserve := sizeLowSpaceReserve + lowSpaceVal;
                        StackTot := StackTot + stackVal;
                    end;
                ReleaseResource(h);
            end;

        SetStackSpace(StackTot);

        MaxApplZone;

        gApp1MemList := nil;
        gApp2MemList := nil;

    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    procedure FailNoReserve;

    begin
        if not CheckReserve then
            Failure(memFullErr, 0);
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    procedure FailSpaceIsLow;

{$IFC qDebug}

        var
            s: MAName;
        {$ENDC}

    begin
    {$IFC qDebug}
        if gAskFailure & CanReadLn then
            begin
                GetCallersMethodName(s);
                if ReadYesNo(Concat('FailSpaceIsLow called by ', s, '.  Return true(Y or N) [N]? ')) then
                    Failure(memFullErr, 0);
            end;
    {$ENDC}

        if MemSpaceIsLow then
            Failure(memFullErr, 0);
    end;

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
{$S MAMemoryRes}

    procedure GetReserveSize (var szCodeReserve, szMemReserve: Size);

    begin
        szCodeReserve := pSzCodeReserve;
        szMemReserve := pSzMemReserve;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$S MAMemoryRes}
                                        { Shouldn't be unloaded }

    function GetSegFromPC (ppc: LONGINT): INTEGER;

        var
            pc: LONGINT;
            i: INTEGER;
            seg: Handle;
            segStart: LONGINT;

    begin
        pc := LongintPtr(ppc)^;

        GetSegFromPC := 0;                                    { default return }

    { Since GetSegFromPC may be called before gCodeSegs is set up, we have to test if gCodeSegs = NIL}
{    before using it.}
        if (gCodeSegs <> nil) then
            for i := 1 to pMaxSegNum do
                begin
                    seg := gCodeSegs^^[i];                        { get segment handle }
                    if (seg <> nil) & not IsHandlePurged(seg) then { it's in memory }
                        begin
                            segStart := StripLong(seg^);            { get segment start }
                            if (pc >= segStart) & (pc < segStart + pSegSize^^[i]) then
                                begin
                                    GetSegFromPC := i;
                                    LEAVE;
                                end;
                        end;
                end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$S MAMemoryRes}
                                        { must be in Main segment because we call}
{                                                         this in order to make the resident segment}
{                                                         resident}

    function GetSegNumber (aProc: ProcPtr): INTEGER;
{ Gets seg number from a Jump table address }

        const
            kLoaded = $4EF9;                    { if loaded then a JMP instruction }
            kUnLoaded = $3F3C;                    { if unloaded then a LoadSeg trap }

        var
            i: INTEGER;
            jt: LONGINT;
            segNum: INTEGER;
            seg: Handle;
            segStart: LONGINT;

    begin
        if IntegerPtr(aProc)^ = kLoaded then                { loaded segment }
            GetSegNumber := IntegerPtr(Ord(aProc) - 2)^
        else if IntegerPtr(aProc)^ = kUnLoaded then         { unloaded segment }
            GetSegNumber := IntegerPtr(Ord(aProc) + 2)^
        else                                                { routine that computed @proc was in same}
{                                                         segment as the proc}
            begin
        {$IFC qDebug}
                ProgramBreak('GetSegNumber was not passed an jump table address');
        {$ENDC}
                GetSegNumber := 0;
            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    function GetSegSize (segNum: INTEGER): Size;

        var
            curResLoad: BOOLEAN;
            seg: Handle;

    begin
        GetSegSize := pSegSize^^[segNum];
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    function GrowZoneProc (needed: Size): LONGINT;

        var
            result: LONGINT;
            canPurge: Handle;
            codeSize: Size;
            reserveSize: LONGINT;
            OldA5: LONGINT;

    begin
        OldA5 := SetCurrentA5;                                { Can be called from other worlds }

        result := 0;                                        { default is to fail }

        if not pDuringGrowZone then                            { prevent re-entrancy }
            begin
                pDuringGrowZone := TRUE;

        { on a temp alloc, free all code slack immediately }
                if not pPermAllocation & HandleIsEligible(pCodeReserve) then
                    begin
                        EmptyHandle(pCodeReserve);
                        pReserveExists := FALSE;
                        result := 1;
                    end;

                if result = 0 then                                    { try harder: see if we can purge a code}
{                                                             segment or reduce the code reserve handle}
{}
                    begin
            { compute size of resources currently in memory }

                        codeSize := TotalTempSize(FALSE, canPurge);

            { see if the code reserve handle is too large }

                        if HandleIsEligible(pCodeReserve) then
                { we have a code reserve handle; this implies permanent allocation,}
{                otherwise the handle would have been emptied above}
                            begin
                                reserveSize := GetHandleSize(pCodeReserve);

                { the following test is an optimization to avoid calling}
{                BuildCodeReserve if there is no hope of reducing}
{                the code reserve handle}
                                if codeSize + reserveSize + 8 > pSzCodeReserve then
                                    begin                                    { reserve is too big }
                                        pReserveExists := FALSE;
                    { this should lower the code reserve }
                                        BuildCodeReserve(reserveSize, TRUE);

                    { see if we succeeded in freeing some memory }
                                        if IsHandlePurged(pCodeReserve) then
                                            result := 1
                                        else if GetHandleSize(pCodeReserve) < reserveSize then
                                            result := 1;
                                    end;
                            end;

                        if (result = 0) & (canPurge <> nil) & (not pPermAllocation | IsHandlePurged(pCodeReserve)) then           { got something; only purge it if this is}
{                                                             temporary OR we know there is too much}
{                                                             code in memory already}
                            begin
                                if gGZPurgeNotify <> nil then
                                    CallNotify(canPurge, gGZPurgeNotify);

                                reserveSize := GetHandleSize(canPurge);
                                HPurge(canPurge);
                                EmptyHandle(canPurge);
                                pReserveExists := FALSE;

                                if pPermAllocation then                     { don't free too much however }
                                    BuildCodeReserve(reserveSize, TRUE);

                                result := 1;
                            end;
                    end;

                if (result = 0) & HandleIsEligible(pMemReserve) then { last ditch attempt-free emergency}
{                                                              reserve}
                    begin
                        EmptyHandle(pMemReserve);
                        result := 1;
                    end;

                pDuringGrowZone := FALSE;
            end;

        GrowZoneProc := result;

        OldA5 := SetA5(OldA5);
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    function HandleIsEligible (h: Handle): BOOLEAN;

    begin
        if IsHandlePurged(h) then
            HandleIsEligible := FALSE
        else
            HandleIsEligible := (h <> GetGZMoveHnd) & (h <> GetGZRootHnd);
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
                                        { Must be in same segment as grow zone proc}
{}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    procedure InstallGrowZoneProc;
{ Once called the grow zone proc's segment CANNOT be moved since we're passing a NON-JT address}
{to SetGrowZone (so we can be called from "other worlds"}

        var
            aZone: THz;

    begin
        aZone := ApplicZone;
        aZone^.flags := BOR(aZone^.flags, $0400);
  { set the Memory Manager bit that says to always call the}
{   Grow Zone proc, even in "non-critical" situations}

        pDuringGrowZone := FALSE;

        SetGrowZone(@GrowZoneProc);

    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S Main}
                                                { Must be in main segment and called from}
{                                                         main segment}

    procedure InitUMemory;

        var
            codeRes, lowSpaceRes: Size;
            miniInitSeg, utilitySeg: Handle;
            mainSeg: integer;

    begin

    { Get these segments out of the way so that when DoInitUMemory gets called and the next}
{    block of master pointers gets allocated they won't constipate the heap}
        miniInitSeg := GetResource(kCode, GetSegNumber(@DoInitUMemory));
        if miniInitSeg <> nil then
            begin
                UnLoadSeg(@DoInitUMemory);
                LockHandleHigh(miniInitSeg);
            end;

        DoInitUMemory(codeRes, lowSpaceRes);

        UnloadAllSegments;                                    { get init segment(s) out of middle of heap,}
{                                                         so SetReserveSize has maximum space to}
{                                                         work with}

        if miniInitSeg <> nil then                            { Yes, this would eventually get purged if}
{                                                         the space was needed badly enough, but}
{                                                         that happens very late in the game and can}
{                                                         confound the unwary}
            EmptyHandle(miniInitSeg);

        InstallGrowZoneProc;

        SetReserveSize(codeRes, lowSpaceRes);
        if not pOKCodeReserve then                            { couldn't get code reserve. Can't continue}
{}
            Failure(memFullErr, 0)
        else
    { Set up the LoadSeg patch }

            FailOSErr(PatchTrap(pSegLoadPatch, _LoadSeg, @ALoadMacAppSeg));

    end;

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
{$D-}
 {$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$S MAMemoryRes}
                                        { must be in Main segment }

    function LoadMacAppSegment (segNum: INTEGER): LONGINT;

        var
        {$IFC qDebug}
            id: INTEGER;
            kind: ResType;
            segName: Str255;
            s: MAName;
            seg: Handle;
        {$ENDC}
            A5RegisterOnEntry: LONGINT;

    begin
        A5RegisterOnEntry := SetCurrentA5;                    { ***** Called from trap patches *****}

        LoadMacAppSegment := pSegLoadPatch.oldTrapAddr;     { Where to go next }

        if GetA5 <> A5RegisterOnEntry then
            begin
        { not called from our application… don't do patch behaviour. Thank you McSink! }
                pLoadSegCalledFromOwnApp := FALSE;
                if SetA5(A5RegisterOnEntry) <> 0 then
                    ;
            end
        else
            begin
                pLoadSegCalledFromOwnApp := TRUE;
                pOldResFile := MAUseResFile(gCodeRefNum);        { Must set a global because we return from}
{                                                         this function and then forward to the}
{                                                         actual segment loader which should also be}
{                                                         pointing to the _now_ correct resfile.}
{                                                         When we get called back again in}
{                                                         PostLoadMacAppSegment we will restore the}
{                                                         old resFile as the current resFile. Sorry}
{                                                         about the global.}

        {$IFC qDebug}
                if (ORD(GetResLoad) = 0) then
                    begin
                        SetResLoad(TRUE);
                        ProgramBreak('Whoops… LoadSeg called with resload set false');
                        Failure(minErr, 0);                         {??? Assign an error code someday or}
{                                                         setresload to TRUE ???}
                    end;

        {$ENDC}

                if not PreloadSegmentResource(segNum) then
                    begin
            {$IFC qDebug}
                        GetCallersMethodName(s);
                        SetResLoad(FALSE);
                        if qNeedsROM128k | gConfiguration.hasROM128k then
                            seg := MAGet1Resource(kCode, segNum)
                        else
                            seg := MAGetResource(kCode, segNum);
                        GetResInfo(seg, id, kind, segName);
                        SetResLoad(TRUE);
                        ProgramBreak(Concat('In ', s, ConcatNumber(' couldn''t load segment: ', segNum), ' ', segName));
            {$ENDC}
                        Failure(memFullErr, 0)
                    end;

                gIsLoadedSeg^^[segNum] := TRUE;

        {$IFC qDebug}
                if gSegReport then
                    begin
            { Cause the debugger to break at the start of the next routine. }
                        gReportNext := TRUE;
                        GetResInfo(gCodeSegs^^[segNum], id, kind, segName);
                        gReportInfo := Concat(ConcatNumber('  *** Segment Loaded: ', segNum), ' ', segName);
                        gSingleStep := gMemMgtBreak;
                    end;
        {$ENDC}

            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$Z+}
{$D-}
{$S MAMemoryRes}
                                        { must be in Main segment }

    procedure PostLoadMacAppSegment;

        var
            A5RegisterOnEntry: LONGINT;

    begin
        A5RegisterOnEntry := SetCurrentA5;                    { ***** Called from trap patches *****}

        if (GetA5 <> A5RegisterOnEntry) | not pLoadSegCalledFromOwnApp then
            begin
        { not called from our application… don't do patch behaviour. Thank you McSink! }
                if SetA5(A5RegisterOnEntry) <> 0 then
                    ;
            end
        else
    { Called back from our glue.  Restores current res file pointer. }
            begin
                if pLoadSegCalledFromOwnApp then
                    if MAUseResFile(pOldResFile) <> 0 then
                        ;
                if SetA5(A5RegisterOnEntry) <> 0 then
                    ;

            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
                                        { Must be in Main segment }

    procedure LoadResidentSegments;

        var
            resIndex: INTEGER;
            i: INTEGER;
            offset: INTEGER;
            nameList: Handle;
            segNumber: INTEGER;
            p: SignedBytePtr;
            name: Str255;
            seg: Handle;
            theType: ResType;

    begin
        for resIndex := 1 to CountResources('res!') do
            begin
                nameList := GetIndResource('res!', resIndex);
                HNoPurge(nameList);

                offset := 2;
                for i := 1 to IntegerPtr(nameList^)^ do
                    begin
                        p := SignedBytePtr(ORD4(nameList^) + offset);
                        BlockMove(Ptr(p), @name, p^ + 1);
                        offset := offset + LENGTH(name) + 1;

                        if qNeedsROM128k | gConfiguration.hasROM128k then
                            seg := MAGet1NamedResource(kCode, name)
                        else
                            seg := MAGetNamedResource(kCode, name);
                        if seg <> nil then
                            begin
                                GetResInfo(seg, segNumber, theType, name);
                                SetResidentSegment(segNumber, TRUE);
                            end;
                    end;

                HPurge(nameList);
                ReleaseResource(nameList);
            end;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function MemSpaceIsLow: BOOLEAN;

    begin
        BuildAllReserves;

        MemSpaceIsLow := IsHandlePurged(pMemReserve);
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function NewPermHandle (logicalSize: Size): Handle;

        const
            initVal = $F3;                        { odd at all byte boundaries }

        var
            priorPerm: BOOLEAN;
        {$IFC qDebug}
            aHandle: Handle;
        {$EndC}

    begin
        priorPerm := PermAllocation(TRUE);
    {$IFC NOT qDebug}
        NewPermHandle := NewHandle(logicalSize);
    {$ELSEC}
        aHandle := NewHandle(logicalSize);
        NewPermHandle := aHandle;
    {$Push}
 {$R-}
        if aHandle <> nil then
            BlockSet(aHandle^, logicalSize, initVal);
    {$Pop}
    {$EndC}
        pPermAllocation := priorPerm;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    function NewPermPtr (logicalSize: Size): Ptr;

        const
            initVal = $F5;                        { odd at all byte boundaries }

        var
            priorPerm: BOOLEAN;
        {$IFC qDebug}
            aPtr: Ptr;
        {$EndC}

    begin
        priorPerm := PermAllocation(TRUE);
    {$IFC NOT qDebug}
        NewPermPtr := NewPtr(logicalSize);
    {$ELSEC}
        aPtr := NewPtr(logicalSize);
        NewPermPtr := aPtr;
    {$Push}
 {$R-}
        if aPtr <> nil then
            BlockSet(aPtr, logicalSize, initVal);
    {$Pop}
    {$EndC}
        pPermAllocation := priorPerm;
    end;

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
{$S MAMemoryRes}

    function PermAllocation (permanent: BOOLEAN): BOOLEAN;

        var
            b: BOOLEAN;

    begin
        PermAllocation := pPermAllocation;

        if permanent <> pPermAllocation then
            begin
                pPermAllocation := permanent;

                if permanent then
                    BuildCodeReserve(kGZMaxAlloc, FALSE);
            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$D-}
{$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$S MAMemoryRes}
                                        { must be in Main segment }

    function PreloadSegmentResource (segNum: INTEGER): BOOLEAN;

        var
            seg: Handle;
            err: OSErr;

        procedure DoGetSegHandle;

        begin
            if qNeedsROM128k | gConfiguration.hasROM128k then
                seg := Get1Resource(kCode, segNum)
            else
                seg := GetResource(kCode, segNum);
        end;

    begin
        if qDebug & pPermAllocation then
            begin
                Writeln('segment # = ', segNum : 1);
                ProgramBreak('Trying to load a segment with PermAllocation = TRUE.');
            end;

        WithCodeResFileDo(DoGetSegHandle);

        if seg = nil then
            PreloadSegmentResource := FALSE
        else
            begin
                PreloadSegmentResource := TRUE;

                if not IsHandleLocked(seg) then                 { not yet locked }
                    LockHandleHigh(seg);
            end;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    procedure RemHandle (h: Handle; toList: HandleListHandle);

        var
            p: LONGINT;
            maxP: LONGINT;
            offset: LONGINT;

    begin
        p := Ord(toList^);                                    { Address of first element }
        maxP := p + GetHandleSize(Handle(toList));            { Address past last element }

    { Skip elements until item is found }
        while (p < maxP) & (LongintPtr(p)^ <> Ord(h)) do
            p := p + SizeOf(Handle);

        if p < maxP then                                    { Item was found }
            begin
                offset := Munger(Handle(toList), p - Ord(toList^), nil, SizeOf(Handle), @h, 0);
                FailMemError;
            end;
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    procedure ScanHandles (procedure DoToHandle (h: Handle));

        procedure ScanList (list: HandleListHandle);

            type
                HandlePtr = ^Handle;

            var
                i: INTEGER;
                p: HandlePtr;

        begin
            i := GetHandleSize(Handle(list)) div SizeOf(Handle);

            p := HandlePtr(list^);
            while i > 0 do
                begin
                    DoToHandle(p^);
                    p := HandlePtr(Ord(p) + SizeOf(Handle));
                    i := i - 1;
                end;
        end;

    begin
        ScanList(gCodeSegs);
        if gApp1MemList <> nil then
            ScanList(gApp1MemList);
        ScanList(gSysMemList);
        if gApp2MemList <> nil then
            ScanList(gApp2MemList);
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    procedure SetPermHandleSize (h: Handle; newSize: Size);

        const
            initVal = $F3;                        { odd at all byte boundaries }

        var
            priorPerm: BOOLEAN;
        {$IFC qDebug}
            oldSize: Size;
        {$EndC}

    begin
        priorPerm := PermAllocation(TRUE);
    {$IFC qDebug}
        oldSize := GetHandleSize(h);
    {$EndC}
        SetHandleSize(h, newSize);
        pPermAllocation := priorPerm;                        { Since we are in the memory unit we can}
{                                                         break the encapsulation of the}
{                                                         PermAllocation Call to just set the}
{                                                         pPermAllocation flag back directly. This}
{                                                         lets us be assured that no operations have}
{                                                         occurred that would invalidate the MemErr}
{                                                         flag… thus the following call will give a}
{                                                         true result}
        FailMemError;
    {$IFC qDebug}
    {$Push}
 {$R-}
        if oldSize < newSize then
            BlockSet(Ptr(Ord(h^) + oldSize), newSize - oldSize, initVal);
    {$Pop}
    {$EndC}
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    procedure SetPermPtrSize (p: Ptr; newSize: Size);

        const
            initVal = $F5;                        { odd at all byte boundaries }

        var
            priorPerm: BOOLEAN;
        {$IFC qDebug}
            oldSize: Size;
        {$EndC}

    begin
        priorPerm := PermAllocation(TRUE);
    {$IFC qDebug}
        oldSize := GetPtrSize(p);
    {$EndC}
        SetPtrSize(p, newSize);
        pPermAllocation := priorPerm;                        { Since we are in the memory unit we can}
{                                                         break the encapsulation of the}
{                                                         PermAllocation Call to just set the}
{                                                         pPermAllocation flag back directly. This}
{                                                         lets us be assured that no operations have}
{                                                         occurred that would invalidate the MemErr}
{                                                         flag… thus the following call will give a}
{                                                         true result}
        FailMemError;
    {$IFC qDebug}
    {$Push}
 {$R-}
        if oldSize < newSize then
            BlockSet(Ptr(Ord(p) + oldSize), newSize - oldSize, initVal);
    {$Pop}
    {$EndC}
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}

    procedure SetReserveSize (forCode, forOther: Size);

        var
            oldPerm: BOOLEAN;

    begin
        pSzCodeReserve := forCode;
        pSzMemReserve := forOther;

    { Since the numbers have changed, make sure we start from scratch. }
        pReserveExists := FALSE;
        EmptyHandle(pMemReserve);

        BuildAllReserves;
    end;

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$S MAMemoryRes}
                                        { must be in Main segment }

    procedure SetResidentSegment (segNum: INTEGER; makeResident: BOOLEAN);

        var
        {$IFC qDebug}
            id: INTEGER;
            kind: ResType;
            segName: Str255;
            s: MAName;
        {$ENDC}
            seg: Handle;

    begin
        if makeResident then
            begin
                gIsResidentSeg^^[segNum] := TRUE;
                if not PreloadSegment(segNum) then
                    begin
            {$IFC qDebug}
                        GetCallersMethodName(s);
                        SetResLoad(FALSE);
                        if qNeedsROM128k | gConfiguration.hasROM128k then
                            seg := MAGet1Resource(kCode, segNum)
                        else
                            seg := MAGetResource(kCode, segNum);
                        SetResLoad(TRUE);
                        GetResInfo(seg, id, kind, segName);
                        ProgramBreak(Concat('In ', s, ConcatNumber(' couldn''t load segment: ', segNum), ' ', segName));
            {$ENDC}
                        Failure(memFullErr, 0)
                    end
            end
        else
            begin
                gIsResidentSeg^^[segNum] := FALSE;
            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMiniInit}

    procedure SetStackSpace (numBytes: LONGINT);

        var
            curLimit: LONGINT;
            newLimit: LONGINT;

    begin
        newLimit := Ord(GetCurStackBase) - numBytes;

        if Ord(GetApplLimit) > newLimit then
            SetApplLimit(Ptr(newLimit));
    end;

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    function TotalTempSize (justLocked: BOOLEAN; var canPurge: Handle): Size;

        var
            total: Size;
            applZone: THz;

        procedure TotalUp (h: Handle);

            var
                hIsLocked: BOOLEAN;

        begin
            if not IsHandlePurged(h) then                    { in memory already }
                if HandleZone(h) = applZone then            { in application heap }
                    begin
                        HNoPurge(h);

                        hIsLocked := IsHandleLocked(h);

                        if not justLocked | hIsLocked then
                            total := total + GetHandleSize(h) + 8;
                { add in the size plus heap overhead }

                        if not hIsLocked then
                            if canPurge = nil then
                                if HandleIsEligible(h) then
                                    canPurge := h;
                    end;
        end;

    begin
        canPurge := nil;
        total := 0;
        applZone := ApplicZone;

        ScanHandles(TotalUp);

        TotalTempSize := total;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAMemoryRes}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}

    procedure WithCodeResFileDo (procedure DoWithResFile);

        var
            oldResFile: INTEGER;

    begin
        oldResFile := MAUseResFile(gCodeRefNum);
        DoWithResFile;
        if MAUseResFile(oldResFile) <> 0 then
            ;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push}
 {$IFC qTrace}
 {$N+}
 {$ENDC}
                     { no %_BP/%_EP allowed in here, because we}
{                                                         cannot call to any other segment from this}
{                                                         procedure}
{$S MAMemoryRes}
                                        { must be in Main segment }

    procedure UnloadAllSegments;

        var
            i: LONGINT;
            seg: Handle;
            jumpTablePtr: LONGINT;
            oldResLoad: BOOLEAN;

        procedure DoToFrame (calleeFrame: LONGINT; ppc: LONGINT; callerFrame: LONGINT; itsFrame: LONGINT);

            var
                seg: INTEGER;

        begin
            seg := GetSegFromPC(ppc);
            if (seg <> 0) & not gIsResidentSeg^^[seg] & gIsLoadedSeg^^[seg] then
                begin
                    Writeln('Segment#: ', seg : 2);
                    ProgramBreak('I really don''t think that you want to unload a segment into which you are going to return!')
                end;
        end;

        procedure UnloadEm;

            var
                i: integer;

        begin
            for i := 1 to pMaxSegNum do
                if not gIsResidentSeg^^[i] & gIsLoadedSeg^^[i] then
                    begin
                        seg := gCodeSegs^^[i];
                        if (seg <> nil) & not IsHandlePurged(seg) then
                            begin
{$IFC NOT OPTION(FarCode)}
                                UnLoadSeg(Ptr(jumpTablePtr + IntegerHandle(seg)^^ + 2));
{$ELSEC}
                                UnLoadSeg(Ptr(jumpTablePtr + (Ord4(IntegerHandle(seg)^^) * 8) + 2));
{$ENDC}
                                gIsLoadedSeg^^[i] := FALSE;
                            end;
                    end;
        end;

    begin
    {$IFC qDebug}
        CheckRsrcUsage;
    {$ENDC}

        if gUnloadAllSegs then
            begin
                jumpTablePtr := Ord(GetA5) + GetCurJTOffset;

        {$IFC qDebug}
                EachFrameDo(Ord(GetCurStackFramePtr), Ord(GetCurStackFramePtr) + 4, DoToFrame);
        {$EndC}

                WithCodeResFileDo(UnloadEm);

        {$IFC qDebug}
                if gSegReport then
                    ProgramReport('  *** Just unloaded all segments ***', gMemMgtBreak);
        {$ENDC}
            end;
    end;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$IFC qDebug}
{$S MADebug}

    procedure WriteReserves;

{ WRITELN's the temporary reserve and low-memory reserves in the}
{debug window.}

    begin
        WrLblPtr('Temporary reserve (pCodeReserve)', pCodeReserve);
        Writeln;
        WrLblPtr('Low-memory reserve (pMemReserve)', pMemReserve);
        Writeln;
    end;
{$ENDC}


end.